\ The Rest is Silence 26Sep83map************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** *** (415) 525-8582 (415) 644-3421 *** *** *** ************************************************************* ************************************************************* ( Load Screen to Bring up Standard System 02Oct83map) 4 VIEW# C! ( Set up as View File# 4 ) 12 CONSTANT STRINGS 15 CONSTANT EDITING 33 CONSTANT DUMPING 36 CONSTANT SEEING 48 CONSTANT SHOWING 3 LOAD ( Utilities ) STRINGS LOAD EDITING LOAD DUMPING LOAD SEEING LOAD SHOWING LOAD CR .( Standard System Loaded ) ( Load Screen To Bring up Options 31Jul83map) 54 CONSTANT BUGGING 57 CONSTANT TASKING BUGGING LOAD TASKING LOAD CR .( System Options Loaded ) \ Basic Utilities Load Screen 06Oct83mapONLY FORTH ALSO DEFINITIONS VARIABLE FUDGE 10 FUDGE ! : MS (S n -- ) 0 ?DO FUDGE @ 0 ?DO LOOP LOOP ; : U<= (S u1 u2 -- f ) U> NOT ; : U>= (S u1 u2 -- f ) U< NOT ; : <= (S n1 n2 -- f ) > NOT ; : >= (S n1 n2 -- f ) < NOT ; : 0>= (S n1 n2 -- f ) 0< NOT ; : 0<= (S n1 n2 -- f ) 0> NOT ; VOCABULARY HIDDEN 1 7 +THRU \ Output Formatting 27Sep83map: >TYPE (S adr len -- ) TUCK PAD SWAP CMOVE PAD SWAP TYPE ; VARIABLE LMARGIN 0 LMARGIN ! VARIABLE RMARGIN 70 RMARGIN ! : ?LINE (S n -- ) #OUT @ + RMARGIN @ > IF CR LMARGIN @ SPACES THEN ; : ?CR (S -- ) 0 ?LINE ; \ Managing Source Screens 30Sep83map: LIST (S n -- ) 1 ?ENOUGH CR DUP SCR ! ." Scr # " DUP . L/SCR 0 DO CR I 3 .R SPACE DUP BLOCK I C/L * + C/L -TRAILING >TYPE KEY? ?LEAVE LOOP DROP CR ; : TRIAD (S n -- ) 12 EMIT ( form feed ) 3 / 3 * 3 BOUNDS DO I LIST LOOP ; : INDEX (S n1 n2 -- ) 2 ?ENOUGH 1+ SWAP DO CR I 3 .R SPACE I BLOCK C/L -TRAILING >TYPE I 3 MOD 2 = IF CR THEN KEY? ?LEAVE LOOP CR ; : IND (S n -- ) BEGIN DUP 3 MOD 0= IF CR THEN CR DUP 3 .R SPACE DUP BLOCK C/L -TRAILING >TYPE 1+ KEY? UNTIL DROP ; \ Display the WORDS in the Context Vocabulary 27Sep83map: LARGEST (S addr n -- addr' val ) OVER 0 SWAP ROT 0 DO 2DUP @ U< IF -ROT 2DROP DUP @ OVER THEN 2+ LOOP DROP ; : WORDS (S -- ) CR LMARGIN @ SPACES CONTEXT @ HERE #THREADS 2* CMOVE BEGIN HERE #THREADS LARGEST DUP WHILE DUP L>NAME DUP C@ 31 AND ?LINE .ID SPACE SPACE @ SWAP ! KEY? IF EXIT THEN REPEAT 2DROP ; ONLY DEFINITIONS FORTH ALSO : WORDS WORDS ; ONLY FORTH ALSO DEFINITIONS \ Iterated Interpretation 27Sep83mapVARIABLE #TIMES ( # times already performed ) 1 #TIMES ! : TIMES ( n -- ) 1 #TIMES +! #TIMES @ < IF 1 #TIMES ! ELSE >IN OFF THEN ; : MANY (S -- ) KEY? NOT IF >IN OFF THEN ; : WHEN (S f -- ) PAUSE NOT IF R> 4 - >R THEN ; \ Managing Source Screens 08SEP83HHL: N (S -- ) 1 SCR +! ; : B (S -- ) -1 SCR +! ; : L (S -- ) SCR @ LIST ; : ESTABLISH (S n -- ) 1 BUFFER# ! ; : (COPY) ( from to -- ) OFFSET @ + SWAP BLOCK DROP ESTABLISH UPDATE ; : COPY FLUSH (COPY) FLUSH ; CREATE VIEW-FILES 32 ALLOT : VIEW (S -- ) ' >VIEW @ DUP -4096 AND ?DUP IF 4096 / 15 AND 1- 2* VIEW-FILES + PERFORM THEN 4095 AND LIST ; \ Disk copy utility 08APR83HHLVARIABLE HOPPED ( # screens copy is offset ) VARIABLE U/D DEFER CONVEY-COPY ' (COPY) IS CONVEY-COPY : HOP ( n -- ) ( specifies n screens to skip ) HOPPED ! ; : .TO ( #1 #2 -- #1 #2 ) CR OVER . ." to " DUP . ; : (CONVEY) (S blk n -- blk+-n ) 0 ?DO KEY? ?LEAVE DUP DUP HOPPED @ + .TO CONVEY-COPY U/D @ + LOOP FLUSH ; : CONVEY (S first last -- ) FLUSH HOPPED @ 0< IF 1+ OVER - 1 ELSE DUP 1+ ROT - -1 THEN U/D ! #BUFFERS /MOD >R (CONVEY) R> 0 ?DO #BUFFERS (CONVEY) LOOP DROP ; : TO ( #1st-source #last-source -- #1st-source #last-source ) ( #1st-dest must follow TO ) SWAP BL WORD NUMBER DROP OVER - HOP SWAP ; \ MultiFile Screen Moving 02AUG83HHLONLY FORTH ALSO FILES ALSO DEFINITIONS : COPY (S from to -- ) SWAP EXCHANGE BLOCK SWAP EXCHANGE BLOCK B/BUF CMOVE UPDATE ; : CONVEY (S n1 n2 -- ) ['] CONVEY-COPY >BODY @ >R ['] COPY IS CONVEY-COPY CONVEY R> ['] CONVEY-COPY >BODY ! ; ONLY FORTH ALSO DEFINITIONS \ String Functions Load Screen 11APR83HHL 1 2 +THRU CR .( Strings Loaded ) EXIT The String manipulation primitives include string comparison andsearching. The string search implemented is used in the editor to find the desired string. The only unusual thing about it is the presence of a variable called CAPS, which determines whether or not to ignore the case of the subject and pattern strings. If case is ignored then A-Z = a-z. The default is ignore case. \ String Functions Case Conversions 27Sep83map: UPC (S c -- c ) DUP ASCII a ASCII z BETWEEN IF BL - THEN ; EXIT : ?UPCHAR (S char -- char' ) CAPS @ IF UPC THEN ; : COMPARE (S a1 a2 n -- +1,0,-1 ) >R 0 -ROT R> 0 ?DO OVER I + C@ ?UPCHAR OVER I + C@ ?UPCHAR - DUP IF >R ROT DROP R> 0< IF -1 ELSE 1 THEN -ROT LEAVE ELSE DROP THEN LOOP 2DROP ; \ String operators 16Oct83map: INSERT (S string length buffer size -- ) ROT OVER MIN >R R@ - ( left over ) OVER DUP R@ + ROT CMOVE> R> CMOVE ; : REPLACE (S string length buffer size -- ) ROT MIN CMOVE ; : DELETE (S buffer size count -- ) OVER MIN >R R@ - ( left over ) DUP 0> IF 2DUP SWAP DUP R@ + -ROT SWAP CMOVE THEN + R> BLANK ; VARIABLE FOUND : SEARCH ( sadr slen badr blen -- n f ) FOUND OFF OVER >R ROT TUCK 2DUP U< IF 2DROP ELSE - 1+ 0 ?DO 3DUP COMPARE 0= IF FOUND ON LEAVE THEN SWAP 1+ SWAP LOOP THEN DROP NIP R> - FOUND @ ; \ Load Screen for the Editor 12NOV83HHL 1 13 +THRU CR .( Editor Loaded ) ONLY FORTH ALSO DEFINITIONS EXIT The Following editor is compatible with the editor described in Starting Forth. For details on the various commands, see the book Starting Forth by Leo Brodie. There are a few extensions that have been implemented. Most notably, the word NEW which allows you to replace multiple lines. Also, this editor has the ability to display the screen that is being edited continuously. You may need to modify the cursor addressing commands in order to take advantage of this feature. You can edit without using the full screen feature simply by invoking the EDITOR vocabulary and entering commands as usual. Use the L command to see what has happened. \ Terminal Dependant deferred words 08Oct83mapDEFER AT (S col row -- ) ( Upper left is 0,0 ) DEFER BLOT (S col -- ) DEFER -LINE (S -- ) : DARK (S -- ) NOOP DOES> PERFORM #LINE OFF #OUT OFF ; DARK VOCABULARY EDITOR EDITOR ALSO DEFINITIONS DEFER .SCREEN (S -- ) : (AT) (S x y -- ) 2DROP CR ; : (BLOT) (S n -- ) C/L SWAP - SPACES ; : (DARK) (S -- ) 24 0 DO CR LOOP ; ' (AT) IS AT ' (BLOT) IS BLOT ' (DARK) IS DARK ' NOOP IS -LINE ' CR IS .SCREEN \ Move the Editor's cursor around 16Oct83mapB/BUF CONSTANT C/SCR : TOP (S -- ) R# OFF ; : C (S n -- ) R# @ + C/SCR MOD R# ! ; : T (S n -- ) TOP C/L * C ; : CURSOR (S -- n ) R# @ ; : LINE# (S -- n ) CURSOR C/L / ; : COL# (S -- n ) CURSOR C/L MOD ; : +T (S n -- ) LINE# + T ; : 'START (S -- adr ) SCR @ BLOCK ; : 'CURSOR (S -- adr ) 'START CURSOR + ; : 'LINE (S -- adr ) 'CURSOR COL# - ; : #AFTER (S -- n ) C/L COL# - ; : #REMAINING (S -- n ) B/BUF CURSOR - ; : #END (S -- n ) #REMAINING COL# + ; \ buffers 16Oct83mapVARIABLE CHANGED : MODIFIED (S -- ) CHANGED ON UPDATE ; ASCII ^ CONSTANT EOS : ?TEXT (S adr -- adr+1 n ) >R EOS WORD C@ IF R@ C/L 1+ BLANK HERE COUNT R@ PLACE THEN R> COUNT ; 84 CONSTANT C/PAD : 'INSERT (S -- insert-buffer ) PAD C/PAD + ; : 'FIND (S -- find-buffer ) 'INSERT C/PAD + ; : 'VIDEO (S -- video-buffer ) 'FIND C/PAD + ; : .FRAMED (S adr -- ) ." '" COUNT TYPE ." '" ; : .BUFS (S -- ) CR ." I " 'INSERT .FRAMED CR ." F " 'FIND .FRAMED ; : ?MISSING (S n f -- n | ) 0= IF DROP 'FIND .FRAMED ." not found " QUIT THEN ; \ buffers 16Oct83map: KEEP (S -- ) 'LINE C/L 'INSERT PLACE ; : K (S -- ) 'FIND PAD C/PAD CMOVE 'INSERT 'FIND C/PAD CMOVE PAD 'INSERT C/PAD CMOVE ; : W (S -- ) SAVE-BUFFERS ; : 'C#A (S -- 'cursor #after ) 'CURSOR #AFTER MODIFIED ; : (I) (S -- len 'insert len 'cursor #after ) 'INSERT ?TEXT TUCK 'C#A ; : (TILL) (S -- n ) 'FIND ?TEXT 'C#A SEARCH ?MISSING ; : 'F+ (S n1 -- n2 ) 'FIND C@ + ; 10 CONSTANT ID-LEN CREATE ID ID-LEN ALLOT ID ID-LEN ERASE : STAMP (S -- ) ID 'START C/L + ID-LEN - ID-LEN CMOVE ; : ?STAMP (S -- ) CHANGED @ IF STAMP THEN CHANGED OFF ; : N (S -- ) ?STAMP N ; : B (S -- ) ?STAMP B ; \ line editing 05Oct83map: I (S -- ) (I) INSERT C ; : O (S -- ) (I) REPLACE C ; : P (S -- ) 'INSERT ?TEXT DROP 'LINE C/L CMOVE MODIFIED ; : U (S -- ) C/L C 'LINE C/L OVER #END INSERT P ; : X (S -- ) KEEP 'LINE #END C/L DELETE MODIFIED ; : SPLIT (S -- ) PAD C/L 2DUP BLANK 'CURSOR #REMAINING INSERT MODIFIED ; : JOIN (S -- ) 'LINE C/L + C/L 'C#A INSERT ; : WIPE (S -- ) 'START B/BUF BLANK MODIFIED ; : M (S -- ) TRUE ABORT" Use G !" ; : G (S screen line -- ) R# @ >R SCR @ >R T SCR ! KEEP R> SCR ! R> R# ! C/L NEGATE C U C/L C ; : BRING (S screen first last -- ) 1+ SWAP DO DUP [ FORTH ] I G LOOP DROP ; \ find and replace 16Oct83map: FIND? (S - n f ) 'FIND ?TEXT 'CURSOR #REMAINING SEARCH ; : F (S -- ) FIND? ?MISSING 'F+ C ; : S (S n - ) 1 ?ENOUGH FIND? IF 'F+ C EXIT THEN DROP FALSE OVER SCR @ DO N TOP 'FIND COUNT 'CURSOR #REMAINING SEARCH IF 'F+ C DROP TRUE LEAVE ELSE DROP THEN KEY? ABORT" Break!" LOOP ?MISSING ; : E (S -- ) 'FIND C@ DUP NEGATE C 'C#A ROT DELETE ; : D (S -- ) F E ; : R (S -- ) E I ; : TILL (S -- ) 'C#A (TILL) 'F+ DELETE ; : JUST (S -- ) 'C#A (TILL) DELETE ; : KT (S -- ) 'CURSOR (TILL) 'F+ 'INSERT PLACE ; \ screen display 08Oct83map3 CONSTANT DX 1 CONSTANT DY : .LINE (S -- ) LINE# 2 .R SPACE 'LINE COL# >TYPE ASCII ^ EMIT 'CURSOR #AFTER >TYPE ; : REDISPLAY (S line# -- ) DX OVER DY + 2DUP AT DX BLOT AT DUP C/L * 'START + C/L TYPE SPACE . ; : CHANGED? (S line# -- f ) C/L * DUP 'START + SWAP 'VIDEO + C/L COMP ; : .ALL (S -- ) 8 0 AT SCR ? 8 SPACES FILE? 8 SPACES [ FORTH ] L/SCR 0 DO I CHANGED? IF I REDISPLAY THEN LOOP 'START 'VIDEO B/BUF CMOVE 0 17 AT .LINE 0 18 AT -LINE 0 23 AT #OUT OFF ; \ screen editing 16Oct83map: EDIT-AT ( -- ) CURSOR C/L /MOD SWAP DX + SWAP DY + AT ; : NEW (S n -- ) L/SCR SWAP DO [ FORTH ] I [ EDITOR ] T EDIT-AT >IN OFF QUERY SPAN @ IF P ELSE [ FORTH ] I REDISPLAY LEAVE THEN .SCREEN LOOP .SCREEN ; : GET-ID (S -- ) ID C@ 0= IF CR ." Enter your ID: " ID-LEN 0 DO ASCII . EMIT LOOP ID-LEN BACKSPACES ID ID-LEN EXPECT THEN ; \ entering and exiting the editor 16Oct83mapVARIABLE >VOC : QUIT ['] CR IS STATUS >VOC @ CONTEXT ! ; FORTH DEFINITIONS : DONE (S -- ) [ EDITOR ] QUIT CR SCR @ . CHANGED @ NOT IF ." Un" THEN ." modified" ?STAMP W ; : ED (S -- ) [ EDITOR ] GET-ID CHANGED OFF DARK DX 0 AT ." Scr #" SCR ? 'START 'VIDEO B/BUF MOVE L/SCR 0 DO [ FORTH ] I [ EDITOR ] 0 OVER DY + AT DUP 2 .R SPACE DUP C/L * 'START + C/L TYPE SPACE . LOOP 0 23 AT ['] .SCREEN IS STATUS CONTEXT @ >VOC ! EDITOR ; : EDIT (S scr -- ) 1 ?ENOUGH SCR ! [ EDITOR ] TOP ED ; : (WHERE) (S pos scr -- ) EDIT [ EDITOR ] C ; \ ' (WHERE) IS WHERE \ Shadow Screen Support Editor 30Sep83mapVOCABULARY SHADOW ALSO SHADOW DEFINITIONS : DISPLACEMENT (S -- disp ) CAPACITY 2/ ; : 1SHADOW (S -- first ) CAPACITY 2/ ; : >SHADOW (S scr# -- scr#' ) DISPLACEMENT OVER 1SHADOW >= IF - ELSE + THEN ; ONLY FORTH ALSO DEFINITIONS : A (S -- ) SCR @ [ SHADOW ] >SHADOW SCR ! ; SHADOW ALSO DEFINITIONS : CA (S -- ) SCR @ DUP >SHADOW (COPY) A ; : COPY (S from to -- ) 2DUP COPY >SHADOW SWAP >SHADOW SWAP COPY ; : CONVEY (S first last -- ) 2DUP CONVEY >SHADOW SWAP >SHADOW SWAP CONVEY ; \ Shadow Screen Support Editor 29Sep83mapEDITOR ALSO : G (S scr# line -- ) 2DUP G C/L NEGATE C A SWAP >SHADOW SWAP G A ; : BRING (S scr# l1 l2 -- ) 1+ SWAP DO DUP [ FORTH ] I [ SHADOW ] G LOOP DROP ; ONLY FORTH ALSO DEFINITIONS \ MultiFile G and BRING 29Sep83mapONLY FORTH ALSO EDITOR ALSO FILES DEFINITIONS : G (S screen line -- ) R# @ >R SCR @ >R T SCR ! EXCHANGE KEEP R> SCR ! R> R# ! EXCHANGE C/L NEGATE C U C/L C ; : BRING (S screen first last -- ) 1+ SWAP DO DUP [ FORTH ] I [ FILES ] G LOOP DROP ; ONLY FORTH ALSO EDITOR DEFINITIONS \ IBM Cursor Addressing Routines 12NOV83HHLONLY FORTH ALSO EDITOR DEFINITIONS CODE IBM-AT (S x y -- ) AX POP DX POP AL DH MOV BH BH SUB 2 # AH MOV 16 INT NEXT C; CODE IBM-DARK (S -- ) 2 # AX MOV 16 INT NEXT C; : IBM-BLOT (S n -- ) 80 SWAP - SPACES ; : IBM (S -- ) ['] IBM-AT IS AT ['] IBM-DARK IS DARK ['] IBM-BLOT IS BLOT ['] .ALL IS .SCREEN ; IBM ONLY FORTH ALSO DEFINITIONS \ Load Screen for Dumping Utility 11APR83HHL 1 2 +THRU CR .( Dumping Utility Loaded ) EXIT The dump utility gives you a formatted hex dump with the ascii text corresponding to the bytes on the right hand side of the screen. In addition you can use the SM word to set a range of memory locations to desired values. SM displays an address and its contents. You can go forwards or backwards depending upon which character you type. Entering a hex number changes the contents of the location. DL can be used to dump a line of text from a screen. \ General Dump Utility - Output 06Oct83map: .2 (S n -- ) 0 <# # # #> TYPE SPACE ; : D.2 (S addr len -- ) BOUNDS ?DO I C@ .2 LOOP ; : EMIT. (S char -- ) 127 AND DUP BL 126 BETWEEN NOT IF DROP ASCII . THEN EMIT ; : DLN (S addr --- ) CR DUP 4 U.R 2 SPACES 8 2DUP D.2 SPACE OVER + 8 D.2 SPACE 16 BOUNDS ?DO I C@ EMIT. LOOP ; : ?.N (S n1 n2 -- n1 ) 2DUP = IF ." \/" DROP ELSE 2 .R THEN SPACE ; : ?.A (S n1 n2 -- n1 ) 2DUP = IF ." V" DROP ELSE 1 .R THEN ; \ Dump and Fill Memory Utility 06Oct83map: .HEAD (S addr len -- addr' len' ) SWAP DUP -16 AND SWAP 15 AND CR 6 SPACES 8 0 DO I ?.N LOOP SPACE 16 8 DO I ?.N LOOP SPACE 16 0 DO I ?.A LOOP ROT + ; : DUMP (S addr len -- ) BASE @ -ROT HEX .HEAD BOUNDS DO I DLN 16 +LOOP BASE ! ; : DU (S addr -- addr+64 ) DUP 64 DUMP 64 + ; : DL (S line# -- ) C/L * SCR @ BLOCK + C/L DUMP ; \ Load Screen for Decompiler 11APR83HHL 1 11 +THRU CR .( Decompiler Loaded ) EXIT A Forth decompiler is a utility program that translates executable forth code back into source code. Normally this is impossible, since traditional compilers produce more object code than source, but in Forth it is quite easy. The decompileris almost one to one, failing only to correctly decompile the various Forth control stuctures and special compiling words. It was written with modifiability in mind, so if you add your own special compiling words, it will be easy to change the decompiler to include them. This code is highly implementation dependant, and will NOT work on other Forth system. To invoke the decompiler, use the word SEE <name> where <name> is the name of a Forth word. \ Positional case defining word 28AUG83HHL( Subscripts start FROM 0 ) : OUT ( # apf -- ) ( report out of range error ) CR ." Subscript out of range on " DUP BODY> >NAME .ID ." Max is " ? ." tried " . QUIT ; : MAP ( # apf -- a ) ( convert subscript # to address a ) 2DUP @ U< IF 2+ SWAP 2* + ELSE OUT THEN ; : CASE: (S n -- ) ( define positional case defining word ) CONSTANT HIDE ] DOES> ( #subscript -- ) ( executes #'th word ) MAP PERFORM ; \ ASSOCIATIVE: Table Lookup Def. Word 01MAR82HHL : ASSOCIATIVE: CONSTANT DOES> (S N -- INDEX ) DUP @ ( N PFA CNT ) -ROT DUP @ 0 ( CNT N PFA CNT 0 ) DO 2+ 2DUP @ = ( CNT N PFA' BOOL ) IF 2DROP DROP I 0 0 LEAVE THEN ( CLEAR STACK AND RETURN INDEX THAT MATCHED ) LOOP 2DROP ; \ Decompile each type of word 02Oct83mapDEFER (SEE) HIDDEN DEFINITIONS : .WORD (S IP -- IP' ) DUP @ >NAME .ID 2+ ; : .INLINE (S IP -- IP' ) .WORD DUP @ . 2+ ; : .BRANCH (S IP -- IP' ) .WORD DUP @ OVER - . 2+ ; : .QUOTE (S IP -- IP' ) .WORD .WORD ; : .STRING (S IP -- IP' ) .WORD COUNT 2DUP TYPE SPACE + ; \ Decompile each type of word 27AUG83HHL: DOES? (S IP -- IP' F ) DUP 3 + SWAP C@ DOES-OP = ; : .(;CODE) (S IP -- IP' ) .WORD DOES? IF ." DOES> " ELSE DROP FALSE THEN ; : .UNNEST (S IP -- IP' ) ." ; " DROP 0 ; : .FINISH (S IP -- IP' ) .WORD DROP 0 ; \ Classify each word in a definition 23JUN83HHL14 ASSOCIATIVE: EXECUTION-CLASS ( 0 ) ' (LIT) , ( 1 ) ' ?BRANCH , ( 2 ) ' BRANCH , ( 3 ) ' (LOOP) , ( 4 ) ' (+LOOP) , ( 5 ) ' (DO) , ( 6 ) ' COMPILE , ( 7 ) ' (.") , ( 8 ) ' (ABORT") , ( 9 ) ' (;CODE) , ( 10 ) ' UNNEST , ( 11 ) ' (") , ( 12 ) ' (?DO) , ( 13 ) ' (;USES) , \ Classify each word in a definition 23JUN83HHL15 CASE: .EXECUTION-CLASS ( 0 ) .INLINE ( 1 ) .BRANCH ( 2 ) .BRANCH ( 3 ) .BRANCH ( 4 ) .BRANCH ( 6 ) .BRANCH ( 6 ) .QUOTE ( 7 ) .STRING ( 8 ) .STRING ( 9 ) .(;CODE) ( 10 ) .UNNEST ( 11 ) .STRING ( 12 ) .BRANCH ( 13 ) .FINISH ( 14 ) .WORD ; \ Decompile a : definition 15Mar83map: .PFA (S CFA -- ) >BODY BEGIN ?CR DUP @ EXECUTION-CLASS .EXECUTION-CLASS DUP 0= KEY? OR UNTIL DROP ; : .IMMEDIATE (S CFA -- ) >NAME C@ 64 AND IF ." IMMEDIATE" THEN ; \ Display category of word 27Sep83map: .CONSTANT (S CFA -- ) DUP >BODY ? ." CONSTANT " >NAME .ID ; : .VARIABLE (S CFA -- ) DUP >BODY . ." VARIABLE " DUP >NAME .ID ." Value = " >BODY ? ; : .: (S CFA -- ) ." : " DUP >NAME .ID 2 SPACES .PFA ; : .DOES> (S CFA -- ) DUP >NAME .ID ." DOES> " @ 1+ .PFA ; : .USER-VARIABLE (S CFA -- ) DUP >BODY ? ." USER VARIABLE " DUP >NAME .ID ." Value = " >IS ? ; \ Display category of word 11OCT83HHL: .DEFER (S CFA -- ) ." DEFERRED " DUP >NAME .ID ." IS " >IS @ (SEE) ; : .USER-DEFER (S cfa -- ) ." USER DEFERRED " DUP >NAME .ID ." IS " >IS @ (SEE) ; : .OTHER (S CFA -- ) DUP @ OVER >BODY = ( cfa points to the pfa in code words ) IF >NAME .ID ." IS CODE" EXIT THEN DUP @ C@ [ ' FORTH @ C@ ] LITERAL = ( Forth is an example of a CREATE DOES> definition ) IF .DOES> EXIT THEN >NAME .ID ." IS UNKNOWN" ; \ Classify a word based on its CFA 09SEP83HHL6 ASSOCIATIVE: DEFINITION-CLASS ( 0 ) ' QUIT @ , ( 1 ) ' 0 @ , ( 2 ) ' SCR @ , ( 3 ) ' BASE @ , ( 4 ) ' KEY @ , ( 5 ) ' EMIT @ , 7 CASE: .DEFINITION-CLASS ( 0 ) .: ( 1 ) .CONSTANT ( 2 ) .VARIABLE ( 3 ) .USER-VARIABLE ( 4 ) .DEFER ( 5 ) .USER-DEFER ( 6 ) .OTHER ; \ Top level of the Decompiler SEE 29Sep83map: ((SEE)) (S Cfa -- ) CR DUP DUP @ DEFINITION-CLASS .DEFINITION-CLASS .IMMEDIATE ; ' ((SEE)) IS (SEE) FORTH DEFINITIONS : SEE (S -- ) ' (SEE) ; \ Load Screen for PRINT Utility 29Sep83map 1 4 +THRU CR .( Print Utility Loaded ) FORTH DEFINITIONS EXIT The Print Utility allows you to print a range of screens on your printer. If your printer allows it, you can print 6 screens per page. The top level word is SHOW which takes a starting and ending screen number and prints all the non blank screens within the range. SHOW in the EDITOR prints the screens and their shadows. The print utility is currently initialized for an EPSON. If you do not have an EPSON you may have to change the vector called INIT-PR. If your printer cannot print 132 columns per line, then you should use TRIAD instead. \ Variables and Setup 16Oct83map: EPSON (S -- ) CONTROL O EMIT ( EPSON Condensed ) ; DEFER INIT-PR ' NOOP IS INIT-PR 0 CONSTANT LOGO VARIABLE PAGE# ( Current page number ) : PAGE (S -- ) NOOP DOES> PERFORM 1 PAGE# +! #LINE OFF #OUT OFF ; PAGE : FORM-FEED (S -- ) CONTROL L EMIT ; ' FORM-FEED IS PAGE HIDDEN DEFINITIONS CREATE SCR#S 14 ALLOT ( enough room for 6 Screens ) : PR-START (S -- ) PRINTING ON #LINE OFF ['] (PRINT) IS EMIT SCR#S OFF 1 PAGE# ! INIT-PR ; : PR-STOP (S -- ) ['] (EMIT) IS EMIT PRINTING OFF ; \ Print 2 screens across on a page 01Oct83map: TEXT? (S Scr# -- f ) BLOCK DUP C@ BL ASCII ~ BETWEEN ( printable ) IF B/BUF -TRAILING NIP 0<> ( and not empty ) ELSE FALSE THEN ; : PR (S scr -- ) 1 SCR#S +! SCR#S DUP @ 2* + ! ; : 2PR (S Scr1# Scr2# line# -- ) CR DUP 2 .R SPACE C/L * >R PAD 129 BLANK SWAP BLOCK R@ + PAD C/L CMOVE BLOCK R> + PAD C/L + 1+ C/L CMOVE PAD 129 -TRAILING TYPE ; : 2SCR (S Scr1 Scr2 --- ) CR CR 4 SPACES OVER 4 .R 61 SPACES DUP 4 .R 16 0 DO 2DUP I 2PR LOOP 2DROP ; \ Prints 6 screen on a page 05Oct83map: P-HEADING (S -- ) CR CR 5 SPACES ." Page# " PAGE# ? 8 SPACES FILE? CR ; : P-FOOTING (S -- ) CR CR 58 SPACES ." Forth 83 Model" PAGE ; : PR-PAGE (S -- ) P-HEADING SCR#S OFF SCR#S 2+ 3 0 DO DUP @ OVER 6 + @ 2SCR 2+ LOOP DROP P-FOOTING ; : PR-S-PAGE (S -- ) P-HEADING SCR#S OFF SCR#S 2+ 3 0 DO DUP @ OVER 2+ @ 2SCR 4 + LOOP DROP P-FOOTING ; : PR-FLUSH (S -- f ) SCR#S @ DUP ( Any screens left over? ) IF BEGIN SCR#S @ 5 < WHILE 0 PR REPEAT LOGO PR THEN 0<> ; \ Print Page with Shadows 05Oct83mapFORTH DEFINITIONS : SHOW (S first last -- ) [ HIDDEN ] PR-START 1+ SWAP DO I TEXT? IF I PR THEN SCR#S @ 6 = IF PR-PAGE THEN LOOP PR-FLUSH IF PR-PAGE THEN PR-STOP ; SHADOW DEFINITIONS : SHOW (S first last -- ) [ HIDDEN ALSO ] PR-START 1+ SWAP DO I TEXT? IF I PR I [ SHADOW ] >SHADOW PR THEN SCR#S @ 6 = IF PR-S-PAGE THEN LOOP PR-FLUSH IF PR-S-PAGE THEN PR-STOP ; ONLY FORTH ALSO DEFINITIONS : LISTING (S -- ) 1 CAPACITY 2/ 1- [ SHADOW ] SHOW ; \ Load Screen for Debugger Utility 12Oct83mapONLY FORTH ALSO DEFINITIONS 1 2 +THRU CR .( Debugger Hi Level Loaded ) ONLY FORTH ALSO DEFINITIONS EXIT The debugger is designed to let the user single step the execution of a high level definition. To invoke the debugger, type DEBUG XXX where XXX is the name of the word you wish to trace. When XXX executes, you will get a single step trace showing you the word within XXX that is about to execute, and the contents of the parameter stack. If you wish to poke around, type F and you can interpret Forth commands until you type RESUME, and execution of XXX will continue where it left off. This debugger works by patching the NEXT routine, so it is highly machine and implementation dependent. The same idea should work however on any Forth system with a centralized NEXT routine. \ Print a High Level Trace 12Oct83mapBUG DEFINITIONS : L.ID (S nfa len -- ) SWAP DUP .ID DUP NAME> 1- - + SPACES ; VARIABLE SLOW VARIABLE RES : (DEBUG) (S low-adr hi-adr -- ) 1 'DEBUG 2+ C! IP> ! <IP ! PNEXT ; : 'UNNEST (S Pfa -- Pfa' ) BEGIN 1+ DUP @ ['] UNNEST = UNTIL ; \ Enter and Leave the Debugger 06Oct83map: TRACE (S Ip - ) >R .S R> CR @ >NAME 10 L.ID SLOW @ NOT KEY? OR IF SLOW OFF RES OFF ." --> " KEY UPC ASCII C OVER = IF SLOW @ NOT SLOW ! THEN ASCII F OVER = IF DROP BEGIN QUERY RUN RES @ UNTIL THEN ASCII Q OVER = ABORT" Unbug" DROP THEN PNEXT ; ' TRACE 'DEBUG ! FORTH DEFINITIONS : DEBUG (S -- ) ' 2- DUP [ BUG ] 'UNNEST (DEBUG) ; : RESUME (S -- ) [ BUG ] RES ON 0 PNEXT ; ONLY FORTH ALSO DEFINITIONS \ Load Screen for the MultiTasker 18APR83HHLONLY FORTH ALSO DEFINITIONS 1 2 +THRU CR .( MultiTasker Hi Level Loaded ) ONLY FORTH ALSO DEFINITIONS EXIT The MultiTasker is loaded as an application on top of the regular Forth System. There is support for it in the nucleus in the form of USER variables and PAUSEs inserted inside of KEY EMIT and BLOCK. The Forth multitasking scheme is co-operative instead of interruptive. All IO operations cause a PAUSE to occur, and the multitasking loop looks around at all of the current tasks for something to do. \ Activate a Task 17Oct83map: TASK: (S size -- ) CREATE TOS HERE #USER @ CMOVE ( Copy the USER Area ) @LINK UP @ -ROT HERE UP ! !LINK ( I point where he did) DUP HERE + DUP RP0 ! 100 - SP0 ! SWAP UP ! HERE ENTRY LOCAL !LINK ( He points to me) HERE #USER @ + HERE DP LOCAL ! HERE SLEEP ALLOT ; : SET-TASK (S ip task -- ) DUP SP0 LOCAL @ ( Top of Stack ) 2- ROT OVER ! ( Initial IP ) 2- OVER RP0 LOCAL @ OVER ! ( Initial RP ) SWAP TOS LOCAL ! ; : ACTIVATE (S task -- ) R> OVER SET-TASK WAKE ; \ Create a Background Task 17Oct83map: BACKGROUND (S -- ) 400 TASK: HERE @LINK 2- ( get address of new task ) SET-TASK !CSP ] ; EXIT background spooler 1 capacity show stop ; : spool-this spooler activate 3 15 [ shadow ] show stop ; variable counts background counter begin pause 1 counts +! again ; \ The Rest is Silence 23JUN83HHLDon't be fooled by the screen on the left. There is more to come. This is the LOGO screen which will be printed in your listings as the very last screen, if space permits. By the way, feel free to call me at reasonable hours if you want to know something. My phone bill is unfortunately getting out of hand, so I may call you collect if it is long distance. ( Load Screen to Bring up Standard System 02Oct83map) STRINGS Character manipulation and case conversions EDITING The Starting Forth Editor, adapted to split screen DUMPING Formatted Hex dump of memory SEEING A decompiler utility SHOWING A print utility for screens with/without shadows These are the machine independant utilities that are loaded when you want to bring up a standard system. There are no machine dependancies in this file. Even the decompiler is written in a machine independant manner. You may need to add some code to the CPUxx.BLK file to make this possible. ( Load Screen To Bring up Options 31Jul83map) BUGGING The High Level Trace Utility TASKING is a simple MultiTasker, believe it or not. The only reason these are optional is because we haven't implemented them on all of our various machines yet. \ Basic Utilities Load Screen 06Oct83mapSet FUDGE to adjust period of MS. MS delays about n MilliSeconds. Clearly depends on your system clock speed. Adjust FUDGE until delay is right. U<= Unsigned less than or equal. U>= Unsigned greater than or equal. <= Less than or equal. >= Greater than or equal. 0<= Less than or equal to zero. 0>= Greater than or equal to zero. HIDDEN is a vocabulary for internal routines to avoid cluttering up FORTH with all manner of junk. Used by the decompiler and print utilities. \ Output Formatting 30Sep83map>TYPE TYPE for multitasking systems. LMARGIN is the column number of the left margin. RMARGIN is the column number of the right margin. ?LINE Move to left margin on next line if we will be past the right margin after printing n characters. ?CR Move to left margin on next line if we are past the right margin. These words are useful for a variety of output formatting needs. Only WORDS uses the margins currently. See chapter 12 of Starting Forth for a neat example. \ LIST INDEX 31Jul83mapLIST (S n -- ) List the specified screen as 16 lines with 64 characters each. Pressing a key aborts the listing. LIST also makes the specified screen the current screen. TRIAD (S n -- ) Lists three screens per page. For 80 column printers. INDEX (S n1 n2 -- ) Lists the first line of every screen, from n1 through n2. This is very useful for getting a quick idea of what is in a file if you use the first line of every screen as a global screen comment. IND (S n -- ) Single argument INDEX. \ Display the WORDS in the Context Vocabulary 31Jul83mapLARGEST (S addr n -- addr' val ) Given a address and a number of words to examine, return the address and the value of the largest entry in the array. WORDS (S -- ) List the words in the context vocabulary. This can be interrupted any time by pressing any key. Add WORDS to ONLY. \ Iterated Interpretation 28Jul83map#TIMES A variable that keeps track of how many times. TIMES ( n -- ) Re-execute the input stream a specified number of times. MANY (S -- ) Re-execute the input stream until the user presses a key. WHEN (S f -- ) Re-execute the previous word until it returns true. NOTE: WHEN is slightly magic. Usage: : TEST READY WHEN BEEP ; Where READY returns a flag. \ Managing Source Screens 08SEP83HHLN Make the Next screen the current one. B Make the previous (Before) screen the current one. L List the current screen. ESTABLISH Sets the block number of the most recently referenced block. (COPY) The primitive that copies one screen to another. COPY Copies and screen and flushes it to disk. VIEW-FILES An array that points to the FCB of the source VIEW Allows the user to see the source screen of a particular word. If the VIEW# is zero, then the current file is used, otherwise the associated file is opened and viewed. \ Disk copy utility 23MAY83HHLHOPPED The number of screens to skip when copying U/D the direction of the copy, to prevent overlap. CONVEY-COPY deferred so that it can be used in different contextHOP Specifies the number of screens to hop over. .TO Prints a message to keep the user happy. (CONVEY) (S blk n -- blk+-n ) Moves a set of screens in the direction of the copy. CONVEY (S first last -- ) Moves a set of screens by first determining the direction to prevent overlap, and then moving them as a set whose size is determined by the number of available buffers. TO ( #1st-source #last-source -- #1st-source #last-source ) You can use TO instead of HOP if you know the destination screen number instead of the number of screens to skip. \ MultiFile Screen Moving 31Jul83mapCOPY (S from to -- ) Copy a screen from the FROM file to the current file. The current file is unchanged. CONVEY (S n1 n2 -- ) Copy a set of screens from the FROM file to the current file. The current file is unchanged. \ String Functions Case Conversions 30Sep83mapUPC (S c -- c ) Convert a character to Upper Case. The following are included for completeness: ?UPCHAR (S char -- char' ) Convert a character to upper case if CAPS flag is set. COMPARE (S a1 a2 n -- +1,0,-1 ) Compare two strings of equal length. Case may or may not be significant, depending upon the value of CAPS. We return 0 if the strings are equal. We return +1 if the string at a1 is greater than the string at a2, and -1 if the string at a1 is less than the string at a2. \ String operators 30Sep83map The following parameters are input to the string operators: sa string-address sl string-length ba buffer-address bl buffer-length ba bl sl DELETE deletes sl characters from the start of the buffer, filling the end with spaces. sa sl ba bl INSERT inserts the minimum of sl or bl characters into ba from sa. sa sl ba bl REPLACE overwrites the minimum of sl or bl characters onto ba from sa. FOUND A local variable to make life easier. SEARCH ( sadr slen badr blen -- n f ) Search for the s string inside of the b string. If found f is true and n is the offset from the beginning of the string to where the pattern was found. If not found, f is false and n is meaningless. Editor 06Oct83map Defaults to DUMB terminal. \ Terminal Dependant deferred words 29Sep83mapAT Position the cursor at the given x and y co-ordinate BLOT Delete the rest of the current line. n is the x pos. -LINE Delete the current line, causing the rest to scroll up. DARK Clear the screen and home the cursor. Do not be deceived, DARK is indeed a DEFERed word, and can be redirected EDITOR The vocabulary for the editor words. .SCREEN Display the entire screen, or whatever makes sense. (AT) drop x and y and perform CR. (BLOT) Blank the rest of the line with spaces. (DARK) Clear screen with line feeds. Initialize all of the DEFERred words to support the dumbest possible terminal. \ Move the Editor's cursor around 16Oct83mapC/SCR may not be B/BUF on some machines. TOP Go to the TOP of the screen C Move n characters, right or left. T Go to beginning of line n. CURSOR Return the current cursor position. LINE# The current line number. COL# The current column number. +T Go the beginning of line relative to current line. 'START The memory address of the start of the screen 'CURSOR The memory address of the current position. 'LINE The memory address of the beginning of current line. #AFTER Number of character behind cursor on current line. #REMAINING Number of characters behind cursor on screen. #END Number of characters between line start & screen end. \ buffers 16Oct83mapCHANGED indicates whether the screen being edited has been. MODIFIED marks the screen as changed, and sets the update flag. EOS is the character used to denote end of string on input. It allows multiple commands per line. Default is ^. ?TEXT will accept a string to an address, if any input exists. C/PAD characters/pad. Standard requires 84 minimum. 'INSERT, 'FIND, and 'VIDEO are the text buffers. They float above PAD, so their contents change when HERE moves. The alternative is to permanently allocate space for them, which is rather wasteful. .BUFS displays the contents of the insert and find buffers. ?MISSING aborts if flag is false. \ buffers 16Oct83mapKEEP places the current line in the insert buffer. K exchanges the contents of the insert and find buffers. W is a terse way to ensure that all changes are written to disk'C#A is used often. (I) leaves buffer data for insert or overwrite. (TILL) leaves distance to delimiter string. 'F+ adds the length of the found string. ID-LEN is the length of the id buffer. ID contains the user name and date stamp. STAMP places the id into the upper right hand corner of the screen. ?STAMP update id if screen has changed, and clear flag. N and B move to next screen or back, stamping as needed. \ line editing 17Mar83map<text> represents the text following the command. If <text> is null, the contents of the insert buffer are used. I <text> inserts text on the current line at the cursor. O <text> overwrites text on the current line. P <text> replaces the current line with <text> and blanks. U <text> inserts a line under the current line. X deletes the current line and puts it into the insert buffer. SPLIT breaks the current line in two at the cursor. JOIN puts a copy of the next line after the cursor. WIPE clears the screen to blanks. M has been neutralized. It moved a copy of the current line to some other screen. The editor should not affect other screens.G gets a line from another screen, and inserts it in front of the current line. BRING gets several lines. \ find and replace 25Jul83map<text> represents the text following the command. If <text> is null, the contents of the find buffer are used. F <text> finds the text and leaves the cursor just past it. n S <text> searches for the text thru all screens from the current up to n. Each time a match is found, n remains on the stack until screen n is reached. E erases the text just found with F or S. D <text> finds and deletes the text. R <itext> replaces the text just found with <itext> or with the insert buffer. TILL <text> deletes all text on the line from the cursor up to and including <text>. JUST <text> deletes up to, but not including, <text>. 'Justify'KT <text> puts all text between the cursor and <text> inclusive into the insert buffer. 'Keep-Till' \ screen display 16Oct83map Provided that your terminal supports the four routines AT, DARK, BLOT, and -LINE, this code will give a continuous display of the screen being edited. The display is updated automaticallyas each command line finishes ( just before 'OK' is typed ). DX and DY are offsets which allow room for screen number and line numbers. .LINE displays the current line, with the cursor shown as an up-arrow or caret. n REDISPLAY updates the image of line n. n CHANGED? indicates whether line n has changed since last displayed. Sensitive to case changes. .ALL redisplays all lines which have changed, the screen number, the cursor line, and scrolls the command region. ***NOTE*** Assumes 24 line 80 column display. \ screen editing 16Oct83mapEDIT-AT displays the terminal's cursor at the editor's cursor. n NEW moves the terminal's cursor to the start of line n, and overwrites lines until a line is begun with null input ( a Carraige Return). GET-ID checks ID, and if it is empty, prompts for the user's id and date. ***NOTE*** If you are fortunate enough to have a CompuPro or similar system with a clock, you can have the editor id supplied automatically on boot. You will love it! \ entering and exiting the editor 05Oct83map>VOC Used to preserve the Vocabulary during edits QUIT exits the editor without updating or flushing. Turns off scrolling. DONE exits the editor, updates the id stamp, tells you if the screen was modified, flushes the screen to disk, and removes automatic re-display. ED re-enters the editor. It clears and re-initializes the display, and begins automatic re-display of the screen. n EDIT sets SCR to n, then uses ED to start editing. (WHERE) uses EDIT to display the screen where an error occurred while loading. WHERE is an execution vector used by ABORT" to locate errors. Setting WHERE to (WHERE) will cause errors to automatically invoke the editor, with the cursor pointing just after the offending word. \ Shadow Screen Support Editor 02Aug83map DISPLACEMENT offset from a screen to its shadow. 1SHADOW first shadow screen. >SHADOW convert a screen number to or from its shadow. A toggle between a screen and its shadow. ( Alternate ) CA copy a screen to its shadow. COPY copy a screen and its shadow. CONVEY copy a range of screens and their shadows. \ Shadow Screen Support Editor 29Sep83map G Get a line and its shadow. BRING Get a range of lines and their shadows. \ Terminal dependant routines 26Sep83map These were kept few in number to ease the task of adapting the editor to new terminals. If your terminal is different, replace this screen. Routines for several common terminals are included following the editor. The only terminal dependant words are: x y AT direct cursor positioning DARK clear screen and home cursor n BLOT clear to end of line ( from column n ) -LINE delete the current line, causing those below to scroll upwards. \ General Dump Utility - Output 06Oct83map.2 Display a 2 digit number followed by a space. D.2 Display a line of 2 digit numbers. EMIT. Emit the character if it is displayable. Otherwise display it as a period. DLN (S addr --- ) Dump 16 bytes worth of data starting at the specified address. First the address is displayed, then 2 sets of 8 bytes, followed by the Ascii equivalent. ?.N If the two numbers match, display a downwards pointer, otherwise display the number. ?.A If the two numbers match, display a downwards pointer, otherwise display the number. \ Dump and Fill Memory Utility 23JUN83HHL.HEAD (S -- ) Display the header field of a dump, making it easy to index into the data portion of the display. DUMP (S addr len -- ) Dump memory in the range specified. The dump is always in hex, but the current base is unaltered. DU (S addr -- addr+64 ) Dump 64 bytes at the specified address, and increment it. DL (S line# -- ) Dump the specified line number on the current screen. \ Positional case defining word 23JUN83HHL OUT ( # apf -- ) ( report out of range error ) Display an error message if the index is out of range as pointed to by the parameter field. MAP ( # apf -- a ) ( convert subscript # to address a ) Map a subscript and a pfa into an actual address. CASE: (S n -- ) ( define positional case defining word ) A positional case statement. The number of cases is specified for error checking. At runtime, the nth word is executed, depending upon the value on the stack. \ ASSOCIATIVE: Table Lookup Def. Word 23JUN83HHL ASSOCIATIVE: An associative memory word. It must be followed by a set of values to be looked up. At Runtime, the values stored in the parameter field are searched for a match. If one if found, the index to that value is returned. If no match is made, then the number of entries, ie max index + 1 is returned. This is the inverse of an array. \ Decompile each type of word 29Sep83map(SEE) Forward reference to decompile deferred words The following are used only by the decompiler: .WORD (S IP -- IP' ) Display the name of a word, and bump the simulated IP by 2. .INLINE (S IP -- IP' ) Display a word that contains an inline literal value. .BRANCH (S IP -- IP' ) Dispaly a word that contains an inline branch. .QUOTE (S IP -- IP' ) Handles the special case of COMPILE xxx. .STRING (S IP -- IP' ) Displays a word with an inline string arguement. \ Decompile each type of word 23JUN83HHLDOES? (S IP -- IP' F ) Increments simulated IP and returns true if call dodoes there.(;CODE) (S IP -- IP' ) Perhaps continue to decompile a defining word. .FINISH (S IP -- IP' ) Display current word and quit. \ Classify each word in a definition 15Mar83mapEXECUTION-CLASS This table lists all of the special cases that must be decompiled differently from ordinary Forth words like DUP and + etc. At runtime, if the simulated IP points to a word in this group, the corresponding index from this table will be returned, and placed upon the stack. If there is no match, then the last index + 1 is returned. \ Classify each word in a definition 23JUN83HHL.EXECUTION-CLASS This giant case statement handles the special case decompiling needed. Each entry corresponds to an entry in the previous EXECUTION-CLASS associative table. The function of each of these words is to decompile the current word that the simulated IP is pointing to, and advance the simulated IP accordingly. If no match in the table, .WORD is used. \ Decompile a : definition 23JUN83HHL.PFA (S CFA -- ) This decompiles a parameter field which contains a list of code fields, as is found in : definitions. .IMMEDIATE (S CFA -- ) This indicates whether the current word is Immediate or not. \ Display category of word 09SEP83HHL.CONSTANT (S CFA -- ) Decompile a Constant, and prints its value. .VARIABLE (S CFA -- ) Decompile a Variable, giving its location and value. .: (S CFA -- ) Decompile a high level : definition. .DOES> (S CFA -- ) Decompile a word defined by a CREATE DOES> word. .USER-VARIABLE (S CFA -- ) Decompile a USER variable, giving the offset from the base of the user area and the current value. \ Display category of word 29Sep83map.DEFER Tell the user that this is a deferred word and decompile its current definition. .USER-DEFER Tell the user that this is a USER deferred word and decompile its current definition. .OTHER (S CFA -- ) This decompiles words whose category was is not known. Code words are recognized, as are words defined by defining words. The runtime portion of a word defined by a defining word is decompiled, since the parameter field is determined by the CREATE portion and cannot be deciphered. If all else fails, the word is listed as UNKNOWN. \ Classify a word based on its CFA 23JUN83HHL DEFINITION-CLASS This categorizes the different classes of words that the decompiler will handle. For each class, determined by the type of defining word used, the code field is identical. Thus the standard classes are recognized. .DEFINITION-CLASS These are the routines that handle the decompilation of each class. The most useful, and of course most common one is .: which decompiles : definitions. If the class is not recognized, we check to see if it is a CODE word or perhaps defined by a high level CREATE DOES> word. \ Top level of the Decompiler SEE 09SEP83HHL((SEE)) (S Cfa -- ) Takes an arbitrary code field address and decompiles it based upon its definition class. Upon completion, it indicates whether or not the word is immediate. SEE (S -- ) The user interface. To decompile something type SEE xxx \ Variables and Setup 29Sep83mapEPSON sets EPSON MX-80 printer to 132 column mode. INIT-PR sets printer to 132 column. Default is EPSON. LOGO The Screen number of your LOGO screen PAGE# The current page number as we are printing. PAGE Printer dependant. Do a form feed and get to a new page. Increment the page number and reset the line number and the column number. FORM-FEED Print a form feed character. The following words are used only in this utility: SCR#S An array to hold a count and 6 screen numbers. PR-START Initialize everything. PR-STOP Resets the deferred word EMIT to send to terminal. \ Print 2 screens across on a page 29Sep83mapTEXT? (S Scr# -- f ) Given a screen number, returns true if the first character in the screen is printable and the screen is not blank. PR (S scr -- ) Add the screen to the array and increment the pointers. 2PR (S Scr1# Scr2# line# -- ) Print the specified line from the two screens given on the stack. The line from scr2 is copied to pad and the line from scr1 is appended, and the result is printed. 2SCR (S Scr1 Scr2 --- ) Print 2 screens across on a page. Calls 2PR on a line by line basis. \ Prints 6 screen on a page 29Sep83mapP-HEADING (S -- ) Prints the heading for each new page. P-FOOTING (S -- ) Prints the footing for each new page. Assumes form feed worksPR-PAGE (S -- ) Prints a page worth of screens without shadows. The screens are printed in vertical columns, 6 up on a page. PR-S-PAGE (S -- ) Prints a page worth of screens with shadows. The source code appears in the left column, and the associated shadow on the right column. PR-FLUSH (S -- f ) Fills the SCR#S array if a page is partially filled. Returns true if there is more to print, otherwise false. \ Print Page with Shadows 05Oct83mapSHOW is the used to print a range of screens, from first to last. Screens are printed six to each page. This requires a printer capable of 132 columns per line. Some printers, like the Epson, must be put into a mode where 132 columns per line are available. Blank screens are not printed. SHADOW SHOW is similar, but prints three screens and their three shadows on each page. Typical usage: 1 20 SHOW or 1 20 SHADOW SHOW See the multi-tasker for an example of print spooling. LISTING print entire file, with shadows. 12Oct83map For example, DEBUG WORDS will trace the execution of WORDS the next time it is used. \ Print a High Level Trace 12Oct83mapPut component words in BUG vocabulary. L.ID print the name of a word left justified in a field of least len characters. SLOW when true, step continuously. RES when true, resume debugging. See TRACE. 'UNNEST find end of word to debug. \ Enter and Leave the Debugger 12Oct83mapTRACE is executed every other pass thru NEXT. It displays the contents of the parameter stack and the name of the next word to be executed in the routine being debugged. TRACE then waits for a key unless SLOW is true. If the key is C, F, or Q, special action is taken, otherwise a single step is performed. C turns on continuous running ( and SLOW). F re-enters Forth and interprets commands until RESUME is executed. Q aborts the trace and restores NEXT with FIX. DEBUG patches NEXT to the debugging version of NEXT. DEBUG also sets the upper and lower limits of the tracing region to the ends of the parameter field of the specified word. RESUME turns on RES, which enables tracing to continue. \ Examples 17Oct83mapSee BACKGROUND and its shadow for spooler and counter tasks. To enable spooler, once defined, type MULTI. MULTI starts the multi-tasker loop running. SINGLE stops it. Then type SPOOLER WAKE to start the spooler task. To put the spooler on hold, use SPOOLER SLEEP To restart it, use SPOOLER WAKE In general, executing the name of a task leaves the address of its user area on the stack. Words like sleep and wake use that address. \ Activate a Task 30Sep83mapTASK: Name, initialize, and allocate a new task. Copy the USER Area. I point to where he pointed. He points to me. Set initial stack pointers. Set dictionary pointer. Make task ready to execute. Allocate task in host dictionary. SET-TASK assigns an existing task to the code at ip. Get top of stack of the task to be used. Put IP and RP values on its stack. Set its saved stack pointer. ACTIVATE assigns an existing task to the following code, and makes it ready to execute. \ Create a Background Task 30Sep83mapBACKGROUND Create a new task of default size. Initialize it to execute the following code. Examples: This creates a task named spooler which lists the current file. STOP is needed at the end of a task. Assigns existing task named spooler to show screens 3 thru 15, and their shadows. The task named counter executes an infinite loop, so STOP is notrequired. Note that you MUST use PAUSE, or no other tasks will be executed. PAUSE is built in to all words which do I/O, so tasks which do I/O ( like spooler ) do not need to use PAUSE explicitly.
